home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL2NO5.ARC / BOUNDRY.LSP next >
Encoding:
Text File  |  1987-05-13  |  9.1 KB  |  239 lines
  1. ;==============================================================================
  2. ;| david claflin, architect                                                   |
  3. ;| claflin design consulting                                                  |
  4. ;| 2098 garfield avenue                                                       |
  5. ;| louisville, colorado 80027                                                 |
  6. ;| 303-673-0866                                                               |
  7. ;==============================================================================
  8. ;
  9. ;program distnote.lsp
  10. ;copyright december 1986 by david w. claflin
  11. ;program to note the bearing and distance between two points
  12. ;or the two ends of a line for Architects and Civil Engineers
  13. ;who don't have a cogo package and need to label boundary lines
  14. ;
  15. ;you can change the layer names, colors, and linetypes as you
  16. ;see fit
  17. ;
  18. (defun C:CLEAN (); delete this function if you already have it loaded
  19. (setq atomlist (member 'C:CLEAN atomlist))
  20. 'DONE
  21. );close defun
  22. ;
  23. ;functions half,spcg,spc,rtd,and convert are all utility functions
  24. ;to clean up the main program
  25. ;
  26. (defun half (pi)   ;returns 90 degrees in radians
  27.    (/ pi 2))
  28. ;   
  29. (defun spcg (ts)   ;returns line spacing = 1/2 text size
  30.    (/ ts 2))
  31. ;   
  32. (defun spc (ts)   ;returns offset from end of line = 2 x text size
  33.    (* ts 2))      
  34. ;
  35. (defun rtd (ang / )   ;converts radians to degrees
  36.    (* (/ ang pi) 180.0))
  37. ;
  38. (defun convert (angtext)   ;replaces d in text string with degrees 
  39. symbol
  40.    (setq newtext "" test nil)
  41.    (setq L (strlen angtext))
  42.    (setq n 4)
  43.    (while (<= n L)
  44.       (setq ds (substr angtext n 1))
  45.       (if (= ds "d")
  46.          (progn
  47.             (setq ds "%%d")
  48.             (setq test T)
  49.             (setq newtext (strcat (substr angtext 1 (1- n))
  50.                            ds (substr angtext (1+ n))))
  51.          );close progn
  52.       );close if
  53.       (if (= T test)(setq n (1+ L)) (setq n (1+ n)))
  54.    );close while
  55.    (setq angtext newtext)
  56. );close defun
  57. ;                              
  58. ;main program begins here
  59. ;cflag for centered, right justified, or left justified text location
  60. ;lflag for above or below line text location
  61. ;tflag for text content - bearing only, distance only, or both
  62. ;
  63. (defun C:DISTNOTE ()
  64. (graphscr)
  65. (setq save (getvar "CLAYER"));saves current layer
  66. (setvar "CMDECHO" 0);turns off command echoing to screen
  67. (setq cont "Y");initializes value for repeating program
  68. (setq pstring (strcat "Text height <default="
  69.      (rtos (getvar "TEXTSIZE") 2 2) ">: "))
  70.    ;sets default value for text height prompt
  71. (command "LAYER" "MAKE" "BRG_DIST" "COLOR" "RED" "BRG_DIST" "")
  72. ;places text on new layer brg_dist with color=red
  73.   ;a layer ltype command could be added here if desired
  74.   
  75.  (setq tflag (strcase
  76.    (getstring "Bearing only, Distance only, or both - Type B, D, or BD
  77.       <default=BD>: ")))
  78.    (if (= tflag "")(setq tflag "BD"));default
  79.    (if (or (= tflag "B")(= tflag "D"))
  80.    (progn    
  81.    (setq lflag (strcase
  82.       (getstring "Locate text A, or B line <default=A>: ")))
  83.   (if (= lflag "") (setq lflag "A"))
  84.    );close progn - then clause of if statement
  85.    (progn    
  86.  (setq lflag (strcase
  87.   (getstring "Locate text A, B, or AB line 
  88. <default=AB>: ")))
  89.   (if (= lflag "") (setq lflag "AB"))
  90.   );close progn - else clause of if statement
  91. );close if  
  92.   (setq cflag (strcase
  93.    (getstring "Right end, Centered, or Left end of line 
  94. <default=C>: ")))
  95.   (if (= cflag "") (setq cflag "C"));default
  96.   (setq ts (getdist pstring));sets text height
  97.   (if (= ts nil) (setq ts (getvar "TEXTSIZE")));default
  98.   (while (= cont "Y");repeats with same values
  99.    (setq pt1 (osnap (getpoint "First point: ") "node,endpoint"))
  100.    (setq pt2 (osnap (getpoint "Second point: ") "node,endpoint"))
  101.    (setq dist (distance pt1 pt2))
  102.    (setq ang (angle pt1 pt2))
  103.    (setq disttext (strcat (rtos dist 2 2) "'"));adds feet symbol to 
  104. string
  105.    (setq angtext (angtos ang 4 4));converts angle to surveyor units
  106.    (if (> (strlen angtext) 6)(setq angtext (convert angtext)));see 
  107. convert
  108.    (if (or (= lflag "A") (= lflag "B"))
  109.      (progn
  110.      (cond
  111.      ((= tflag "BD")(setq txt (strcat angtext "   " 
  112. disttext)))
  113.      ((= tflag "B")(setq txt angtext))
  114.      ((= tflag "D")(setq txt disttext))
  115.      );close cond
  116.      );close progn
  117.     );close if
  118.    (cond
  119.         ((= cflag "L")
  120.          (setq loc (polar pt1 ang (spc ts))))
  121.         ((= cflag "C")
  122.         (setq loc (polar pt1 ang (/ dist 2))))
  123.         ((= cflag "R")
  124.            (setq loc (polar pt1 ang (- dist (spc ts)))))
  125.         );close cond - starting location for text
  126.         (setq locOFF1 (polar loc (+ ang (half pi)) (spcg ts))); above 
  127. line
  128.         (setq locOFF2 (polar loc (- ang (half pi)) (* (spcg ts) 3))); 
  129. below line
  130.      (setq anglin (rtd ang)); sets text angle to proper units
  131.      (cond
  132.         ((= cflag "L")
  133.            (cond      
  134.               ((= tflag "BD")
  135.                  (cond
  136.             ((= lflag "AB")
  137.                    (command "TEXT" locOFF1 ts anglin angtext)
  138.                    (command "TEXT" locOFF2 ts anglin disttext))
  139.              ((= lflag "A")  
  140.                    (command "TEXT" locOFF1 ts anglin txt))     
  141.              ((= lflag "B")  
  142.                        (command "TEXT" locOFF2 ts anglin txt))
  143.                     ); close cond
  144.                 ); close expresion
  145.                 ((or (= tflag "B")(= tflag "D"))
  146.     (cond 
  147.              ((= lflag "A")  
  148.                    (command "TEXT" locOFF1 ts anglin txt))     
  149.              ((= lflag "B")  
  150.                        (command "TEXT" locOFF2 ts anglin txt))
  151.                     ); close cond
  152.                 ); close expresion
  153.             ); close cond - prints text in proper location and format 
  154.         ); close expresion = "L"
  155.         ((/= cflag "L")
  156.            (cond      
  157.               ((= tflag "BD")
  158.                  (cond
  159.       ((= lflag "AB")
  160.                    (command "TEXT" cflag locOFF1 ts anglin angtext)
  161.                    (command "TEXT" cflag locOFF2 ts anglin 
  162. disttext))
  163.              ((= lflag "A")  
  164.                    (command "TEXT" cflag locOFF1 ts anglin txt))     
  165.              ((= lflag "B")  
  166.                        (command "TEXT" cflag locOFF2 ts anglin txt))
  167.                     ); close cond
  168.                 ); close expresion
  169.                 ((or (= tflag "B")(= tflag "D"))
  170.     (cond 
  171.              ((= lflag "A")  
  172.                    (command "TEXT" cflag locOFF1 ts anglin txt))     
  173.              ((= lflag "B")  
  174.                        (command "TEXT" cflag locOFF2 ts anglin txt))
  175.                     ); close cond
  176.                 ); close expresion
  177.             ); close cond - prints text in proper location and format 
  178.         ); close expresion /= "L"
  179.       ); close cond 
  180.     (setq cont "N")
  181.     (prompt "To change variables type N and execute program again or 
  182. for")
  183.     (setq cont (strcase
  184.        (getstring " another with the same values type Y <default=N>:  
  185. ")))
  186.     (if (null cont)(setq cont "N"));do not repeat
  187.     );close while
  188.     (command "LAYER" "SET" save "")   ;returns to original layer
  189.     'DONE;returns done at exit from program
  190. );close defun  
  191.  
  192. *****************************************************************
  193. *****************************************************************
  194.  
  195.  
  196. (defun C:DOOR ()
  197. ;Wheatley/Williams Architects; 10/18/86
  198. (defun toward (pivot rang rpt);pivot point, reference angle, ref. pt.
  199. (setq d1 (/ (distance pivot rpt) 2))
  200. (setq p1 (polar pivot (+ rang (* 0.5 pi)) d1))
  201. (setq p2 (polar pivot (- rang (* 0.5 pi)) d1))
  202. (if (< (distance p1 rpt)(distance p2 rpt))
  203.      (angle pivot p1) 
  204.      (angle pivot p2) 
  205. ));close if, close toward
  206. (setvar "cmdecho" 0)
  207. (setq hp (getpoint "\nHinge Point: "))
  208. (setq sp (getpoint "\nStrike Point: "))
  209. (setq sang (angle hp sp));strike angle
  210. (setq width (distance hp sp))
  211. (setq oface (getpoint "\nOpposite Face of Wall: "))
  212. (setvar "blipmode" 0)
  213. (command "line" hp "perp" oface "")
  214. (setq ohp (getvar "lastpoint"));opposite hinge point
  215. (command "line" sp "perp" oface "")
  216. (command "copy" "l" "" sp (polar sp sang 2))
  217. (command "copy" "l" "" sp (polar sp (- sang pi)(+ width 4)))
  218. (command "break" (polar hp sang (/ width 2)) "f" hp sp)
  219. (command "break" (polar ohp sang (/ width 2)) "f" ohp (polar ohp sang width))
  220. (setq dang (getangle hp "\nDoor Angle From Hinge Point: "))
  221. (setq mang (+ (min dang sang)
  222.               (/ (setq diffang (abs (- dang sang))
  223.                  ) 2);difference angle, close divide
  224.            ));close add, mid angle
  225. (if (> diffang pi)(setq mang (+ mang pi)))
  226. (setq amp (polar hp mang width))
  227. (if (< (distance amp ohp)(distance amp hp));swing angle > 180
  228.      (progn (setq dang (angle sp hp))
  229.             (setq amp (polar hp (angle ohp hp) width))
  230.             (setq dstrt (polar hp (angle ohp hp) 2)));then
  231.      (setq dstrt (polar hp (toward hp dang sp) 2));else
  232. );close if
  233. (command "trace" 1 dstrt (polar dstrt dang width) "")
  234. (command "arc" sp amp (polar hp dang width))
  235. (setvar "cmdecho" 1)(setvar "blipmode" 1)
  236. );close door
  237.     
  238.  
  239.